home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
gsdbloo.exe
/
GS_OBJTS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-20
|
9KB
|
370 lines
unit GS_Objts;
{-----------------------------------------------------------------------------
Collection Handler
GS_Objts Copyright (c) Richard F. Griffin
14 September 1991
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit handles the objects for collections. This is an
abbreviated version of the Borland TP6 Objects unit. It is
intended as a substitute for use in TP5.5.
Changes:
------------------------------------------------------------------------------}
{$D-}
interface
const
MaxCollectionSize = 65520 div SizeOf(Pointer);
coIndexError = -1; { Index out of range }
coOverflow = -2; { Overflow }
coCollError = 212;
coAbstrError = 211;
type
PString = ^String;
PObject = ^TObject;
TObject = object
constructor Init;
procedure Free;
destructor Done; virtual;
end;
PColPntrs = ^TColPntrs;
TColPntrs = array[0..MaxCollectionSize - 1] of Pointer;
PCollection = ^TCollection;
TCollection = object(TObject)
Items : PColPntrs;
Count : Integer;
Limit : Integer;
Delta : Integer;
constructor Init(ALimit, ADelta: Integer);
destructor Done; virtual;
function At(Index: Integer): Pointer;
procedure AtDelete(Index: Integer);
procedure AtInsert(Index: Integer; Item: Pointer);
procedure AtPut(Index: Integer; Item: Pointer);
procedure Delete(Item: Pointer);
procedure DeleteAll;
procedure Error(Code, Info: Integer); virtual;
procedure Free(Item: Pointer);
procedure FreeAll;
procedure FreeItem(Item: Pointer); virtual;
function IndexOf(Item: Pointer): Integer; virtual;
procedure Insert(Item: Pointer); virtual;
procedure SetLimit(ALimit: Integer); virtual;
end;
PSortedCollection = ^TSortedCollection;
TSortedCollection = object(TCollection)
Duplicates : Boolean;
constructor Init(ALimit, ADelta: Integer);
function Compare(Key1, Key2: Pointer): Integer; virtual;
function IndexOf(Item: Pointer): Integer; virtual;
procedure Insert(Item: Pointer); virtual;
function KeyOf(Item: Pointer): Pointer; virtual;
function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
end;
PStringCollection = ^TStringCollection;
TStringCollection = object(TSortedCollection)
function Compare(Key1, Key2: Pointer): Integer; virtual;
procedure FreeItem(Item: Pointer); virtual;
end;
procedure DisposeStr(p: PString);
function NewStr(S: String): PString;
implementation
{------------------------------------------------------------------------------
Global Procedures/Functions
------------------------------------------------------------------------------}
procedure Abstract;
begin
RunError(coAbstrError);
end;
procedure DisposeStr(p: PString);
begin
if P <> nil then FreeMem(p, Length(p^) + 1);
end;
function NewStr(S: String): PString;
var
p: PString;
begin
if s = '' then p := nil else
begin
GetMem(p, Length(s) + 1);
p^ := s;
end;
NewStr := p;
end;
{------------------------------------------------------------------------------
TObject
------------------------------------------------------------------------------}
constructor TObject.Init;
begin
end;
procedure TObject.Free;
begin
Dispose(PObject(@Self), Done);
end;
destructor TObject.Done;
begin
end;
{------------------------------------------------------------------------------
TCollection
------------------------------------------------------------------------------}
constructor TCollection.Init(ALimit, ADelta: Integer);
begin
TObject.Init;
Items := nil;
Count := 0;
Limit := 0;
Delta := ADelta;
SetLimit(ALimit);
end;
destructor TCollection.Done;
begin
FreeAll;
SetLimit(0);
end;
function TCollection.At(Index: Integer): Pointer;
begin
if (Index < 0) or (Index >= Count) then
begin
Error(coCollError, coIndexError);
At := nil;
end
else At := Items^[Index];
end;
procedure TCollection.AtDelete(Index: Integer);
begin
if (Index >= 0) and (Index < Count) then
begin
if Index < Count-1 then
move(Items^[Index+1],Items^[Index],((Count-1)-Index)*4);
dec(Count);
end
else Error(coCollError, coIndexError);
end;
procedure TCollection.AtInsert(Index: Integer; Item: Pointer);
begin
if (Index >= 0) and (Index <= Count) then
begin
if Count = Limit then SetLimit(Limit+Delta);
if Index <> Count then
move(Items^[Index],Items^[Index+1],(Count-Index)*4);
Items^[Index] := Item;
inc(Count);
end
else Error(coCollError, coIndexError);
end;
procedure TCollection.AtPut(Index: Integer; Item: Pointer);
begin
if (Index >= 0) and (Index <= Count) then
Items^[Index] := Item
else Error(coCollError, coIndexError);
end;
procedure TCollection.Delete(Item: Pointer);
begin
AtDelete(IndexOf(Item));
end;
procedure TCollection.DeleteAll;
begin
Count := 0;
end;
procedure TCollection.Error(Code, Info: Integer);
begin
RunError(Code);
end;
procedure TCollection.Free(Item: Pointer);
begin
Delete(Item);
FreeItem(Item);
end;
procedure TCollection.FreeAll;
var
I: Integer;
begin
for I := 0 to Count - 1 do FreeItem(At(I));
Count := 0;
end;
procedure TCollection.FreeItem(Item: Pointer);
begin
if Item <> nil then Dispose(PObject(Item), Done);
end;
function TCollection.IndexOf(Item: Pointer): Integer;
var
i : integer;
foundit : boolean;
begin
foundit := false;
i := 0;
while not foundit and (i < Count) do
begin
foundit := Item = Items^[i];
if not foundit then inc(i);
end;
if foundit then IndexOf := i else IndexOf := -1;
end;
procedure TCollection.Insert(Item: Pointer);
begin
AtInsert(Count, Item);
end;
procedure TCollection.SetLimit(ALimit: Integer);
var
AItems: PColPntrs;
begin
if ALimit < Count then ALimit := Count;
if ALimit > MaxCollectionSize then ALimit := MaxCollectionSize;
if ALimit <> Limit then
begin
if ALimit = 0 then AItems := nil else
begin
GetMem(AItems, ALimit * SizeOf(Pointer));
if (Count <> 0) and (Items <> nil) then
Move(Items^, AItems^, Count * SizeOf(Pointer));
end;
if Limit <> 0 then FreeMem(Items, Limit * SizeOf(Pointer));
Items := AItems;
Limit := ALimit;
end;
end;
{------------------------------------------------------------------------------
TSortedCollection
------------------------------------------------------------------------------}
constructor TSortedCollection.Init(ALimit, ADelta: Integer);
begin
TCollection.Init(ALimit, ADelta);
Duplicates := False;
end;
function TSortedCollection.Compare(Key1, Key2: Pointer): Integer;
begin
Abstract;
end;
function TSortedCollection.IndexOf(Item: Pointer): Integer;
var
I: Integer;
begin
IndexOf := -1;
if Search(KeyOf(Item), I) then
begin
if Duplicates then
while (I < Count) and (Item <> Items^[I]) do Inc(I);
if I < Count then IndexOf := I;
end;
end;
procedure TSortedCollection.Insert(Item: Pointer);
var
I: Integer;
begin
if not Search(KeyOf(Item), I) or Duplicates then AtInsert(I, Item);
end;
function TSortedCollection.KeyOf(Item: Pointer): Pointer;
begin
KeyOf := Item;
end;
function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
var
L, H, I, C: Integer;
begin
Search := False;
L := 0;
H := Count - 1;
while L <= H do
begin
I :=